stagedfs <- lines <$> hGetContents jlogh
mapM_ (removeFile . (dir </>) . toOsPath) stagedfs
hClose jlogh
- removeWhenExistsWith (R.removeLink) (fromOsPath jlogf)
+ removeWhenExistsWith removeFile jlogf
openjlog tmpdir = liftIO $ openTmpFileIn tmpdir (literalOsPath "jlog")
getLocalTransitions :: Annex Transitions
cleanuplockfile lockfile = void $ tryNonAsync $ do
thawContentDir lockfile
- liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath lockfile
+ liftIO $ removeWhenExistsWith removeFile lockfile
cleanObjectDirs lockfile
{- Runs an action, passing it the temp file to get,
verificationOfContentFailed tmpfile = do
warning "Verification of content failed"
pruneTmpWorkDirBefore tmpfile
- (liftIO . removeWhenExistsWith R.removeLink . fromOsPath)
+ (liftIO . removeWhenExistsWith removeFile)
{- Checks if there is enough free disk space to download a key
- to its temp file.
withTmp key action = do
tmp <- prepTmp key
res <- action tmp
- pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink . fromOsPath)
+ pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile)
return res
{- Moves a key's content into .git/annex/objects/
Database.Keys.addInodeCaches key
(catMaybes (destic:ics))
)
- alreadyhave = liftIO $ R.removeLink $ fromOsPath src
+ alreadyhave = liftIO $ removeFile src
checkSecureHashes :: Key -> Annex (Maybe String)
checkSecureHashes key = ifM (Backend.isCryptographicallySecureKey key)
catMaybes [destic, Just srcic]
return LinkAnnexOk
_ -> do
- liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath dest
+ liftIO $ removeWhenExistsWith removeFile dest
failed
{- Removes the annex object file for a key. Lowlevel. -}
obj <- calcRepo (gitAnnexLocation key)
modifyContentDir obj $ do
secureErase obj
- liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath obj
+ liftIO $ removeWhenExistsWith removeFile obj
{- Runs an action to transfer an object's content. The action is also
- passed the size of the object.
removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file ->
cleanObjectLoc key $ do
secureErase file
- liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath file
+ liftIO $ removeWhenExistsWith removeFile file
g <- Annex.gitRepo
mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g)
=<< Database.Keys.getAssociatedFiles key
dir <- fromRepo dirspec
forM_ dups $ \k ->
pruneTmpWorkDirBefore (dir </> keyFile k)
- (liftIO . R.removeLink . fromOsPath)
+ (liftIO . removeFile)
if nottransferred
then do
- time. -}
removeRetentionTimeStamp :: Key -> OsPath -> Annex ()
removeRetentionTimeStamp key rt = modifyContentDirWhenExists rt $ do
- liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath rt
+ liftIO $ removeWhenExistsWith removeFile rt
rtl <- calcRepo (gitAnnexContentRetentionTimestampLock key)
- liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath rtl
+ liftIO $ removeWhenExistsWith removeFile rtl
}
void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid ->
forceSuccessProcess p pid
- liftIO $ removeWhenExistsWith R.removeLink (fromOsPath socketfile)
+ liftIO $ removeWhenExistsWith removeFile socketfile
{- This needs to be as short as possible, due to limitations on the length
- of the path to a socket file. At the same time, it needs to be unique
removeCreds :: OsPath -> Annex ()
removeCreds file = do
d <- fromRepo gitAnnexCredsDir
- liftIO $ removeWhenExistsWith R.removeLink (fromOsPath (d </> file))
+ liftIO $ removeWhenExistsWith removeFile (d </> file)
includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
includeCredsInfo pc@(ParsedRemoteConfig cm _) storage info = do
mapM_ removeLoose (S.toList $ knownMissing fsckresults)
mapM_ removeBad =<< listLooseObjectShas r
where
- removeLoose s = removeWhenExistsWith R.removeLink $
- fromOsPath $ looseObjectFile r s
+ removeLoose s = removeWhenExistsWith removeFile $ looseObjectFile r s
removeBad s = do
void $ tryIO $ allowRead $ looseObjectFile r s
whenM (isMissing s r) $
createDirectoryIfMissing True (parentDir dest)
moveFile objfile dest
forM_ packs $ \packfile -> do
- removeWhenExistsWith R.removeLink (fromOsPath packfile)
- removeWhenExistsWith R.removeLink (fromOsPath (packIdxFile packfile))
+ removeWhenExistsWith removeFile packfile
+ removeWhenExistsWith removeFile (packIdxFile packfile)
return True
{- Try to retrieve a set of missing objects, from the remotes of a
. fileLines'
<$> catchDefaultIO "" (safeReadFile f)
forM_ rs makeref
- removeWhenExistsWith R.removeLink (fromOsPath f)
+ removeWhenExistsWith removeFile f
where
makeref (sha, ref) = do
let gitd = localGitDir r
{- git-branch -d cannot be used to remove a branch that is directly
- pointing to a corrupt commit. -}
nukeBranchRef :: Branch -> Repo -> IO ()
-nukeBranchRef b r = removeWhenExistsWith R.removeLink $ fromOsPath $
+nukeBranchRef b r = removeWhenExistsWith removeFile $
localGitDir r </> toOsPath (fromRef' b)
{- Finds the most recent commit to a branch that does not need any
| otherwise = do
(bad, good, cleanup) <- partitionIndex r
unless (null bad) $ do
- removeWhenExistsWith R.removeLink (fromOsPath (indexFile r))
+ removeWhenExistsWith removeFile (indexFile r)
UpdateIndex.streamUpdateIndex r
=<< (catMaybes <$> mapM reinject good)
void cleanup
preRepair :: Repo -> IO ()
preRepair g = do
unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do
- removeWhenExistsWith R.removeLink (fromOsPath headfile)
+ removeWhenExistsWith removeFile headfile
writeFile (fromOsPath headfile) "ref: refs/heads/master"
explodePackedRefsFile g
unless (repoIsLocalBare g) $
else successfulfinish modifiedbranches
corruptedindex = do
- removeWhenExistsWith R.removeLink (fromOsPath (indexFile g))
+ removeWhenExistsWith removeFile (indexFile g)
-- The corrupted index can prevent fsck from finding other
-- problems, so re-run repair.
fsckresult' <- findBroken False False g
withBytes content $ \b ->
decrypt cmd encc cipher (feedBytes b) $
readBytes write
- liftIO $ removeWhenExistsWith R.removeLink (fromOsPath f)
+ liftIO $ removeWhenExistsWith removeFile f
(Nothing, _, FileContent f) -> do
withBytes content write
- liftIO $ removeWhenExistsWith R.removeLink (fromOsPath f)
+ liftIO $ removeWhenExistsWith removeFile f
(Nothing, _, ByteContent b) -> write b
where
write b = case mh of
-- new database is not populated. It will be automatically
-- populated from the git-annex branch the next time it is used.
removeOldDb =<< fromRepo gitAnnexContentIdentifierDbDirOld
- liftIO . removeWhenExistsWith (R.removeLink . fromOsPath)
+ liftIO . removeWhenExistsWith removeFile
=<< fromRepo gitAnnexContentIdentifierLockOld
-- The export databases are deleted here. The new databases
populateKeysDb
removeOldDb =<< fromRepo gitAnnexKeysDbOld
- liftIO . removeWhenExistsWith (R.removeLink . fromOsPath)
+ liftIO . removeWhenExistsWith removeFile
=<< fromRepo gitAnnexKeysDbIndexCacheOld
- liftIO . removeWhenExistsWith (R.removeLink . fromOsPath)
+ liftIO . removeWhenExistsWith removeFile
=<< fromRepo gitAnnexKeysDbLockOld
updateSmudgeFilter
hClose h
let failedlock = do
dropSideLock sidelock
- removeWhenExistsWith removeLink tmp'
+ removeWhenExistsWith removeFile tmp
return Nothing
let tooklock st = return $ Just $ LockHandle abslockfile st sidelock
linkToLock sidelock tmp' (fromOsPath abslockfile) >>= \case
Just lckst -> do
- removeWhenExistsWith removeLink tmp'
+ removeWhenExistsWith removeFile tmp
tooklock lckst
Nothing -> do
v <- readPidLock abslockfile
_ -> do
-- Try to clean up the extra copy we made
-- that has the same name. Egads.
- _ <- tryIO $ removeLink $ fromOsPath dest
+ _ <- tryIO $ removeFile dest
return True
-- | Waits as necessary to take a lock.
-- Drop side lock first, at which point the pid lock will be
-- considered stale.
dropSideLock sidelock
- removeWhenExistsWith removeLink (fromOsPath lockfile)
+ removeWhenExistsWith removeFile lockfile
dropLock ParentLocked = return ()
getLockStatus :: PidLockFile -> IO LockStatus
) where
import System.IO
-import System.Directory
import Control.Monad.IO.Class
import System.IO.Error
import Data.Char
import qualified Data.ByteString as B
-import qualified System.FilePath.ByteString as P
import Utility.Exception
import Utility.FileSystemEncoding
import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F
import Utility.OsPath
+import Utility.SystemDirectory
type Template = OsString
viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m ()
viaTmp a file content = bracketIO setup cleanup use
where
- (dir, base) = P.splitFileName (fromOsPath file)
- template = relatedTemplate (base <> ".tmp")
+ (dir, base) = splitFileName file
+ template = relatedTemplate (fromOsPath base <> ".tmp")
setup = do
- createDirectoryIfMissing True (fromRawFilePath dir)
- openTmpFileIn (toOsPath dir) template
+ createDirectoryIfMissing True dir
+ openTmpFileIn dir template
cleanup (tmpfile, h) = do
_ <- tryIO $ hClose h
- tryIO $ R.removeLink (fromOsPath tmpfile)
+ tryIO $ removeFile tmpfile
use (tmpfile, h) = do
let tmpfile' = fromOsPath tmpfile
-- Make mode the same as if the file were created usually,
- (or in "." if there is none) then removes the file. -}
withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a
withTmpFile template a = do
- tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
- withTmpFileIn (toOsPath (toRawFilePath tmpdir)) template a
+ tmpdir <- liftIO $ catchDefaultIO (literalOsPath ".") getTemporaryDirectory
+ withTmpFileIn tmpdir template a
{- Runs an action with a tmp file located in the specified directory,
- then removes the file.
create = liftIO $ openTmpFileIn tmpdir template
remove (name, h) = liftIO $ do
hClose h
- tryIO $ R.removeLink (fromOsPath name)
+ tryIO $ removeFile name
use (name, h) = a name h
{- It's not safe to use a FilePath of an existing file as the template
projects / git-annex.git / commitdiff